
 1000  *SAVE S.DP18 FUNC LOG
 1010  *--------------------------------
 1020  AS.OVRFLW  .EQ $E8D5
 1030  AS.ILLERR  .EQ $E199
 1040  *--------------------------------
 1050  POLY.1     .EQ $FFFF
 1060  POLY.N     .EQ $FFFF
 1070  DADD       .EQ $FFFF
 1080  DSUB       .EQ $FFFF
 1090  DMULT      .EQ $FFFF
 1100  DDIV       .EQ $FFFF
 1110  DP.TRUE    .EQ $FFFF
 1120  MOVE.YA.ARG.1  .EQ $FFFF
 1130  MOVE.YA.DAC.1       .EQ $FFFF
 1140  SWAP.DAC.ARG   .EQ $FFFF
 1150  MOVE.TEMP1.ARG      .EQ $FFFF
 1160  MOVE.TEMP2.ARG      .EQ $FFFF
 1170  MOVE.TEMP3.ARG      .EQ $FFFF
 1180  MOVE.DAC.ARG        .EQ $FFFF
 1190  MOVE.TEMP3.DAC      .EQ $FFFF
 1200  MOVE.DAC.TEMP1      .EQ $FFFF
 1210  MOVE.DAC.TEMP2      .EQ $FFFF
 1220  MOVE.DAC.TEMP3      .EQ $FFFF
 1230  NORMALIZE.DAC       .EQ $FFFF
 1240  *--------------------------------
 1250  DAC.EXPONENT .BS 1
 1260  DAC.HI       .BS 10
 1270  DAC.SIGN     .BS 1
 1280  *--------------------------------
 1290  ARG.EXPONENT .BS 1
 1300  ARG.HI       .BS 10
 1310  ARG.SIGN     .BS 1
 1320  *--------------------------------
 1330  SIGN         .BS 1
 1340  INTPWR       .BS 1
 1350  *--------------------------------
 1360  CON.ONE    .HS 41.10000.00000.00000.00000
 1370  CON.1HALF  .HS 40.50000.00000.00000.00000
 1380  CON.SQR10  .HS 41.31622.77660.16837.93320
 1390  *--------------------------------
 1400  *      EXP (DAC)    E^DAC
 1410  *             OR    10^DAC
 1420  *      #1446 IN HART, ET AL
 1430  *--------------------------------
 1440  P.EXP    .EQ *
 1450  P.EXP.N  .EQ 3
 1460           .HS 42.31341.17940.19730.48777
 1470           .HS 44.45618.28316.94656.35848
 1480           .HS 46.13433.11347.35855.59034
 1490           .HS 46.76025.44794.41265.39434
 1500  Q.EXP    .EQ *
 1510  Q.EXP.N  .EQ 4
 1520           .HS 43.47705.44030.08207.98775
 1530           .HS 45.29732.60655.85996.83303
 1540           .HS 46.40843.69796.67736.28236
 1550           .HS 46.66034.86505.27141.54491
 1560  *--------------------------------
 1570  CON.LOGE .HS 40.43429.44819.03251.82765
 1580  *--------------------------------
 1590  DP.EXP.NULL
 1600         JMP DP.TRUE  E^0 = 10^0 = 1.0
 1610  DP.EXP.OVERFLOW
 1620         JMP AS.OVRFLW
 1630  *--------------------------------
 1640  DP.EXPE
 1650         LDA DAC.EXPONENT
 1660         BEQ DP.EXP.NULL
 1670         LDA #CON.LOGE
 1680         LDY /CON.LOGE
 1690         JSR MOVE.YA.ARG.1
 1700         JSR DMULT    CHANGE TO 10^X
 1710  *--------------------------------
 1720  DP.EXP10
 1730         LDX DAC.EXPONENT       10^0 = 1
 1740         BEQ DP.EXP.NULL
 1750  *---HANDLE NEGATIVE POWERS-------
 1760         LDA DAC.SIGN SAVE FOR 1/EXP IF NEGATIVE
 1770         STA SIGN
 1780         LDA #0       GET ABS(X)
 1790         STA DAC.SIGN
 1800  *---SPLIT INTEGER & FRACTION-----
 1810         CPX #$43     THREE OR MORE INTEGER DIGITS?
 1820         BCS DP.EXP.OVERFLOW   YES, OVERFLOW
 1830         LDA #0       ...ALL FRACTIONAL
 1840         STA INTPWR
 1850         CPX #$41
 1860         BCC .3       ...NO INTEGRAL PART
 1870         LDA DAC.HI   ...1 OR 2 DIGITS
 1880         LSR
 1890         LSR
 1900         LSR
 1910         LSR
 1920         STA INTPWR
 1930         LDA DAC.HI
 1940         AND #$0F
 1950         STA DAC.HI
 1960         CPX #$41     ONE OR TWO DIGITS?
 1970         BEQ .2       ...ONE DIGIT INTEGER
 1980         LDA INTPWR    DIGIT*10
 1990         ASL
 2000         ASL
 2010         ADC INTPWR
 2020         ASL
 2030         ADC DAC.HI
 2040         STA INTPWR
 2050         LDX #0
 2060         STX DAC.HI
 2070  .2     JSR NORMALIZE.DAC   ADJUST REMAINING FRACTION
 2080         BNE .3              FRACTION NOT 0
 2090         JSR DP.TRUE         10^0 = 1
 2100         JMP .7
 2110  *---ADJUST FRACTION SO < .5------
 2120  .3     LDA DAC.EXPONENT
 2130         CMP #$40
 2140         BCC .4
 2150         LDA DAC.HI
 2160         CMP #$50
 2170  .4     PHP          REMEMBER...
 2180         BCC .5       ...ALREADY < .5
 2190         SBC #$50
 2200         STA DAC.HI
 2210         JSR NORMALIZE.DAC
 2220         BNE .5       ...REST OF FRACTION NOT 0
 2230         PLA          POP SAVED STATUS
 2240         LDA #CON.SQR10
 2250         LDY /CON.SQR10
 2260         JSR MOVE.YA.DAC.1
 2270         JMP .7
 2280  *---COMPUTE 10^.XXXX-------------
 2290  .5     JSR MOVE.DAC.TEMP1    SAVE X
 2300         JSR MOVE.DAC.ARG
 2310         JSR DMULT             GET X^2
 2320         JSR MOVE.DAC.TEMP2    SAVE X^2
 2330         LDA #P.EXP            COMPUTE P(X^2)
 2340         LDY /P.EXP
 2350         LDX #P.EXP.N
 2360         JSR POLY.N
 2370         JSR MOVE.TEMP1.ARG    COMPUTE XP(X^2)
 2380         JSR DMULT
 2390         JSR MOVE.DAC.TEMP3    SAVE XP(X^2)
 2400         LDA #Q.EXP            COMPUTE Q(X^2)
 2410         LDY /Q.EXP
 2420         LDX #Q.EXP.N
 2430         JSR POLY.1
 2440         JSR MOVE.DAC.TEMP2    SAVE Q(X^2)
 2450         JSR MOVE.TEMP3.ARG    NUMERATOR = Q+XP
 2460         JSR DADD              Q(X^2)+XP(X^2)
 2470         JSR MOVE.DAC.TEMP1    SAVE UMERATOR
 2480         JSR MOVE.TEMP2.ARG    DENOMINATOR = Q-XP
 2490         JSR MOVE.TEMP3.DAC
 2500         JSR DSUB              Q(X^2)-XP(X^2)
 2510         JSR MOVE.TEMP1.ARG    10^.XXX = N/D
 2520         JSR DDIV
 2530  *---ADJUST BY SQR(10)------------
 2540         PLP          SEE IF ADJUSTMENT NEEDED
 2550         BCC .7       ...NO
 2560         LDA #CON.SQR10
 2570         LDY /CON.SQR10
 2580         JSR MOVE.YA.ARG.1
 2590         JSR DMULT
 2600  *---ADD INTEGRAL POWER-----------
 2610  .7     CLC
 2620         LDA DAC.EXPONENT
 2630         ADC INTPWR
 2640         BPL .8       ...NO OVERFLOW
 2650         JMP DP.EXP.OVERFLOW
 2660  .8     STA DAC.EXPONENT
 2670  *---ADJUST FOR SIGN--------------
 2680         LDA SIGN     GET ORIGINAL SIGN
 2690         BPL .9       POSITIVE, WE ARE DONE
 2700         LDA #CON.ONE NEGATIVE, FORM RECIPROCAL
 2710         LDY /CON.ONE
 2720         JSR MOVE.YA.ARG.1
 2730         JSR DDIV
 2740  .9     RTS
 2750  *--------------------------------
 2760  *      LN (DAC)  LOG E (DAC)
 2770  *           OR   LOG 10 (DAC)
 2780  *      #2330 IN HART, ET AL
 2790  *--------------------------------
 2800  P.LOG    .EQ *
 2810  P.LOG.N  .EQ 5
 2820           .HS C2.14933.41871.23101.49868
 2830           .HS 43.30132.34734.14748.46138
 2840           .HS C4.17255.36265.00653.03387
 2850           .HS 44.40598.33123.94476.21513
 2860           .HS C4.41923.45602.07081.07911
 2870           .HS 44.15764.33484.51127.69255
 2880  Q.LOG    .EQ *
 2890  Q.LOG.N  .EQ 6
 2900           .HS C2.67696.41190.46224.52758
 2910           .HS 43.76357.00230.09155.79877
 2920           .HS C4.32000.87986.36664.12225
 2930           .HS 44.61216.00041.77468.78069
 2940           .HS C4.54315.94950.92575.25735
 2950           .HS 44.18149.36120.76616.30282
 2960  *--------------------------------
 2970  CON.LN10 .HS 41.23025.85092.99404.56840
 2980  *--------------------------------
 2990  DP.LOGE
 3000         JSR DP.LOG10
 3010         LDA #CON.LN10     CONVERT LOG10 TO LN
 3020         LDY /CON.LN10
 3030         JSR MOVE.YA.ARG.1
 3040         JMP DMULT
 3050  *--------------------------------
 3060  DP.LOG.ERR
 3070         JMP AS.ILLERR
 3080  *--------------------------------
 3090  DP.LOG10
 3100         LDA DAC.SIGN      CHECK RANGE
 3110         BMI DP.LOG.ERR    ...NEGATIVE
 3120         LDA DAC.EXPONENT
 3130         BEQ DP.LOG.ERR    ...ZERO
 3140         STA INTPWR        SAVE POWER OF 10
 3150  *---ADJUST RANGE-----------------
 3160         LDA #$40          MAKE FRACTION .1 TO .9999
 3170         STA DAC.EXPONENT
 3180         LDA #CON.SQR10    1/SQR(10) ... SQR(10)
 3190         LDY /CON.SQR10
 3200         JSR MOVE.YA.ARG.1
 3210         JSR DMULT
 3220  *---FORM (X-1)/(X+1)-------------
 3230         JSR MOVE.DAC.TEMP1
 3240         JSR MOVE.DAC.ARG
 3250         JSR DP.TRUE       GET 1 IN DAC
 3260         JSR DSUB          X-1
 3270         JSR MOVE.DAC.TEMP2 SAVE IT
 3280         JSR DP.TRUE       GET 1 IN DAC
 3290         JSR MOVE.TEMP1.ARG
 3300         JSR DADD          X+1
 3310         JSR MOVE.TEMP2.ARG
 3320         JSR DDIV          X-1/X+1
 3330  *---NUMERATOR = Z*P(Z^2)---------
 3340         JSR MOVE.DAC.TEMP1 SAVE IT
 3350         JSR MOVE.DAC.ARG
 3360         JSR DMULT         Z^2
 3370         JSR MOVE.DAC.TEMP2 SAVE Z^2
 3380         LDA #P.LOG
 3390         LDY /P.LOG
 3400         LDX #P.LOG.N
 3410         JSR POLY.N
 3420         JSR MOVE.TEMP1.ARG
 3430         JSR DMULT         Z*P(Z^2)
 3440         JSR MOVE.DAC.TEMP1
 3450  *---DENOMINATOR = Q(Z^2)---------
 3460         LDA #Q.LOG
 3470         LDY /Q.LOG
 3480         LDX #Q.LOG.N
 3490         JSR POLY.1
 3500         JSR MOVE.TEMP1.ARG
 3510         JSR DDIV          Z*P(Z^2)/Q(Z^2)
 3520  *---ADD INTEGER POWER------------
 3530         SEC
 3540         LDA INTPWR        GET POWER OF 10
 3550         SBC #$40
 3560         BEQ .5            ...0, NO NEED TO ADD ANYTHING
 3570         STA ARG.SIGN
 3580         BCS .1            ...1 TO 63
 3590         EOR #$FF          MAKE IT POSITIVE
 3600         ADC #1
 3610  .1     LDY #0
 3620         STY ARG.HI
 3630         LDX #$41
 3640         CMP #10
 3650         BCC .3            1...9
 3660         INX               10...63
 3670  .2     STA ARG.HI        STORE REMAINDER
 3680         SBC #10
 3690         INY               INC. QUOTIENT
 3700         BCS .2            ...TRY ANOTHER SUBTRACTION
 3710         DEY               CORRECT QUOTIENT
 3720         TYA               GET QUOTIENT
 3730  .3     ASL               LEFT JUSTIFY
 3740         ASL
 3750         ASL
 3760         ASL
 3770         ORA ARG.HI        MERGE WITH NEXT DIGIT
 3780         STA ARG.HI
 3790         STX ARG.EXPONENT  $41 OR $42
 3800         LDX #9            CLEAR REST OF ARG
 3810         LDA #0
 3820  .4     STA ARG.HI,X
 3830         DEX
 3840         BNE .4
 3850         JSR DADD
 3860  *---SUBTRACT 0.5-----------------
 3870  .5     LDA #CON.1HALF
 3880         LDY /CON.1HALF
 3890         JSR MOVE.YA.ARG.1
 3900         LDA #$FF
 3910         STA ARG.SIGN
 3920         JMP DADD
 3930  *--------------------------------

